home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / GS_GENF.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-29  |  11KB  |  369 lines
  1. Unit GS_GenF;
  2. {------------------------------------------------------------------------------
  3.                               DBase File Builder
  4.  
  5.        Copyright (c)  Richard F. Griffin
  6.  
  7.        20 February 1992
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.        This unit creates a test dBase file and adds records to an
  14.        existing test file.
  15.  
  16.        The unit uses two external files to generate data.  The first is
  17.        TESTDATA.FIL, which contains names and addresses the routines use
  18.        to randomly generate data.  The second file is WISDOM.FIL, which
  19.        contains one-liners used to randomly create memo fields.  Each of
  20.        these files may be modified to fit the user's requirements.
  21.  
  22.        File structure is:
  23.  
  24.               LASTNAME    C   30    0
  25.               FIRSTNAME   C   30    0
  26.               STREET      C   30    0
  27.               OFFICE      C   30    0
  28.               CITY        C   30    0
  29.               STATE       C   2     0
  30.               ZIP         C   10    0
  31.               TELEPHONE   C   20    0
  32.               BIRTHDATE   D    8    0
  33.               PAYMENT     N    9    2
  34.               PAIDFLAG    L    1    0
  35.               RANDOMNUM   N   12    5
  36.               UNIQUEID    C    8    0
  37.               COMMENTS    M   10    0   (Only included if Memo Field requested)
  38.  
  39.        The MakeTestData unit is called as follows for database creation:
  40.  
  41.           MakeTestData(namFile, numRecs, MemoAlso);
  42.  
  43.           where:
  44.                   namFile  = file name without the file extension
  45.                   numRecs  = number of records to insert
  46.                   MemoAlso = boolean true to create a memo file and records,
  47.                              false to omit a memo field.
  48.  
  49.        The AddTestData unit is called as follows for additional records:
  50.  
  51.           AddTestData(namObjt, numRecs);
  52.  
  53.           where:
  54.                   namObjt  = Pointer to the GS_dBFld_Objt object for the file
  55.                   numRecs  = number of records to add
  56.  
  57. -------------------------------------------------------------------------------}
  58. interface
  59. {$D-}
  60.  
  61. uses
  62.    CRT,
  63.    DOS,
  64.    GS_Date,
  65.    GS_Objts,
  66.    GS_Strng,
  67.    GS_MakMo,
  68.    GS_dBase,
  69.    GS_dBFld,
  70.    GS_dB3Wk;
  71.  
  72.  
  73. procedure MakeTestData(namFile : string; numRecs : integer;
  74.                        MemoAlso : boolean);
  75. procedure AddTestData(namObjt : GSP_dBFld_Objt; numRecs : integer);
  76.  
  77. implementation
  78. const
  79.  
  80.    CollectionsEmpty : boolean = true;
  81.  
  82.    yearweight : array [0..6] of word
  83.               = (7665,14600,14600,23725,32850,40150,40150);
  84.    memoweight : array [0..7] of word
  85.               = (0,500,500,1000,1500,1000,500,500);
  86.  
  87. type
  88.    FldRecPtr   = ^FldRecTyp;
  89.    FldRecTyp   = array[1..GS_dBase_MaxRecField] of GS_dBase_Field;
  90.  
  91. var
  92.    fli : text;
  93.    flp : text;
  94.    s   : string;
  95.    i,
  96.    j,
  97.    k   : integer;
  98.    x   : integer;
  99.  
  100.    gfMemoColl : GS_MakeMemoP;
  101.    gfMemoArray : array[0..50] of word;
  102.    gfMemoLines : integer;
  103.    gfMemoBytes : longint;
  104.    gfMemoAvg : integer;
  105.    gfLastName : string[30];
  106.    gfFirstName : string[30];
  107.    gfStreet : string[80];
  108.    gfOffice : string;
  109.    gfState : string[2];
  110.    gfZip   : string[5];
  111.    gfCity  : string[30];
  112.    gfTelePhone : string[20];
  113.    gfBirthDate : string[8];
  114.    gfPayment : string[9];
  115.    gfPaidFlag : string[1];
  116.    gfRandomNum : string[12];
  117.    gfUniqueID  : string[8];
  118.    SZC    : string;
  119.  
  120.    MoColl,
  121.    LNColl,
  122.    FNColl,
  123.    StColl,
  124.    OfColl,
  125.    SZColl : TCollection;
  126.  
  127.    f : FldRecPtr;
  128.    t : string;
  129.    FLoc : integer;
  130.  
  131.    dbx : GSP_dBFld_Objt;
  132.    useMemo : boolean;
  133.  
  134. procedure InsertField(s : string; t : char; l,d : integer);
  135. begin
  136.    if FLoc >= GS_dBase_MaxRecField then exit;
  137.    inc(FLoc);
  138.    s := AllCaps(s);
  139.    CnvStrToAsc(s,f^[FLoc].FieldName,11);
  140.    f^[FLoc].FieldType := t;
  141.    f^[FLoc].FieldLen := l;
  142.    f^[FLoc].FieldDec := d;
  143.    f^[FLoc].FieldAddress := 0;
  144.    FillChar(f^[FLoc].Reserved,20,#0);
  145. end;
  146.  
  147.  
  148. procedure MakeCollections;
  149. begin
  150.    FileMode := 66;
  151.    assign(fli,'testdata.fil');
  152.    reset(fli);
  153.    LNColl.Init(32,32);
  154.    FNColl.Init(32,32);
  155.    StColl.Init(32,32);
  156.    OfColl.Init(32,32);
  157.    SZColl.Init(32,32);
  158.    x := 0;
  159.    readln(fli,s);
  160.    while not EOF(fli) do
  161.    begin
  162.       s := TrimR(s);
  163.       if s[1] = '%' then
  164.       begin
  165.          if s = '%LASTNAME' then x := 1;
  166.          if s = '%FIRSTNAME' then x := 2;
  167.          if s = '%STREET' then x := 3;
  168.          if s = '%OFFICE' then x := 4;
  169.          if s = '%STATEZIPCITY' then x := 5;
  170.       end
  171.       else
  172.       case x of
  173.          1 : LNColl.Insert(NewStr(s));
  174.          2 : FNColl.Insert(NewStr(s));
  175.          3 : StColl.Insert(NewStr(s));
  176.          4 : OfColl.Insert(NewStr(s));
  177.          5 : SZColl.Insert(NewStr(s));
  178.       end;
  179.       readln(fli,s);
  180.    end;
  181.    close(fli);
  182.    if not useMemo then exit;
  183.    gfMemoBytes := 0;
  184.    assign(fli,'wisdom.fil');
  185.    reset(fli);
  186.    MoColl.Init(2000,500);
  187.    readln(fli,s);
  188.    while not EOF(fli) do
  189.    begin
  190.       s := TrimR(s);
  191.       gfMemoBytes := gfMemoBytes + ord(s[0]);
  192.       MoColl.Insert(NewStr(s));
  193.       readln(fli,s);
  194.    end;
  195.    close(fli);
  196.    gfMemoAvg := gfMemoBytes div MoColl.Count;
  197. end;
  198.  
  199. Function RandString(l,h : integer) : string;
  200. var
  201.    v : integer;
  202.    g : string;
  203. begin
  204.    v := random((h-l)+1);
  205.    v := v + l;
  206.    str(v,g);
  207.    RandString := g;
  208. end;
  209.  
  210. procedure BuildRecordData;
  211. var
  212.    i1,
  213.    j1,
  214.    j2,
  215.    k1  : word;
  216.    i2  : longint;
  217.    tf  : boolean;
  218.    s1  : string[5];
  219. begin
  220.    j := random(LNColl.Count);
  221.    gfLastName := PString(LNColl.At(j))^;
  222.    j := random(FNColl.Count);
  223.    gfFirstName := PString(FNColl.At(j))^ + ' ' + chr(Random(26)+65) + '.';
  224.    j := random(StColl.Count);
  225.    gfStreet := RandString(10,9999) + ' ' + PString(StColl.At(j))^;
  226.    j := random(OfColl.Count*3);
  227.    if j < OfColl.Count then
  228.       gfOffice := PString(OfColl.At(j))^ + ' ' + RandString(1,99)
  229.    else gfOffice := '';
  230.    j := random(SZColl.Count);
  231.    s := PString(SZColl.At(j))^;
  232.    gfState := copy(s,1,2);
  233.    gfZip := copy(s,3,5);
  234.    gfCity := copy(s,8,30);
  235.    gfTelePhone := RandString(100,600) + ' ' + RandString(100,999) + '-' +
  236.                   RandString(1000,9999);
  237.    i1 := yearweight[random(7)];
  238.    i2 := random(i1)+1;
  239.    gfBirthDate := GS_Date_dBStor(GS_Date_Curr - i2);
  240.    i1 := random(20000) + 1;
  241.    str(i1:6,gfPayment);
  242.    gfPayment := gfPayment + '.' + RandString(10,99);
  243.    i1 := random(2);
  244.    if i1 = 0 then gfPaidFlag := 'F' else gfPaidFlag := 'T';
  245.  
  246.    i1 := random(2);
  247.    if i1 = 0 then gfRandomNum := '-' else gfRandomNum := '';
  248.    s1 := RandString(0,30000);
  249.    while length(s1) < 5 do s1 := s1+'0';
  250.    gfRandomNum := gfRandomNum + RandString(0,30000) + '.' + s1;
  251.    while length(gfRandomNum) < 12 do gfRandomNum := ' ' + gfRandomNum;
  252.    gfUniqueID := Unique_Field;
  253.    if not useMemo then exit;
  254.    gfMemoColl^.ResetMemoData;
  255.    j2 := random(8);
  256.    j2 := memoweight[j2];
  257.    if j2 = 0 then exit;
  258.    s := '--- ' + gfLastName + ', ' + gfFirstName + ' Memo Record';
  259.    gfMemoColl^.InsertMemoData(s+#13#10);
  260.    gfMemoLines := random(j2 div gfMemoAvg);
  261.    i1 := 0;
  262.    while i1 <= gfMemoLines do
  263.    begin
  264.       j1 := random(MoColl.Count);
  265.       tf := true;
  266.       if i1 > 0 then
  267.          for k1 := 0 to i1 do if j1 = gfMemoArray[k1] then tf := false;
  268.       if tf then
  269.       begin
  270.          s := PString(MOColl.At(j1))^;
  271.          gfMemoColl^.InsertMemoData(s+#13#10);
  272.          gfMemoArray[i1] := j1;
  273.          inc(i1);
  274.       end;
  275.    end;
  276. end;
  277.  
  278. procedure MakeTestData(namFile : string; numRecs : integer;
  279.                        MemoAlso : boolean);
  280. begin
  281.    useMemo := MemoAlso;
  282.    if CollectionsEmpty then MakeCollections;
  283.    CollectionsEmpty := false;
  284.  
  285.            {Create new dBase file}
  286.  
  287.    New(f);
  288.    FLoc := 0;
  289.    InsertField('LASTNAME','C',30,0);
  290.    InsertField('FIRSTNAME','C',30,0);
  291.    InsertField('STREET','C',30,0);
  292.    InsertField('OFFICE','C',30,0);
  293.    InsertField('CITY','C',30,0);
  294.    InsertField('STATE','C',2,0);
  295.    InsertField('ZIP','C',10,0);
  296.    I